{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Timing;

interface

uses Classes, Types, Timers, AHMTypes, SyncObjs;

const
  DISPLAY_POWER_INTERVAL = 20; // Number of seconds for preventing monitor power save
  MILLISECS_PER_SEC = 1000; // Number of milliseconds in one second
  FPS_MEASURE_TIME = MILLISECS_PER_SEC; // Interval over which we calculate FPS
  FPS_MINIMUM = 5; // Minimum frames per second throttle allowed
  FPS_MAXIMUM = 100; // Maximum frames per second throttle allowed
  FRAME_TIMEOUT = 2; // Delay we allow UI to sync rendering with video presentation
  VIDEO_TIMEOUT = 100; // Delay before UI times out whilst waiting for video (10 FPS)
  VIDEO_MAX_FAILS = 25; // Maximum number of times we allow missing video sync before aborting (5 secs)

type
  TAHMTiming = class
  private
    FActualFPS: Integer;
    FMaximumFPS: Integer;
    FFrameThrottle: Integer;
    FAverageFrameTime: Integer;
    FCurrentFrameTime: Integer;
    FTotalFrameTime: Integer;
    FStartedDate: TDateTime;
    FStartedTime: TDateTime;
    FLaunchTimestamp: TAHMTimestamp;
    FFrameTimestamp: TAHMTimestamp;
    FCurrentTimestamp: TAHMTimestamp;
    FFPSTimestamp: TAHMTimestamp;
    FDisplayPowerTimestamp: TAHMTimestamp;
    FFrameCount: Integer;
    FDateFormat: String;
    FTimeFormat: String;
    FCurrentDate: String;
    FCurrentTime: String;
    FRenderEvent: TEvent;
    FRequestEvent: TEvent;
    FFailedFrames: Integer;
    FExternalTiming: Boolean;
    FProfiles: TStringList;
    FExpired: Boolean;
  protected
    procedure SetMaximumFPS(MaximumFPS: Integer);
    procedure GetCurrentDateAndTime;
    function GetRunningTime: TDateTime;
    function GetProfilingCount: Integer;
    function GetProfilingName(Index: Integer): String;
    function GetProfilingDelay(Index: Integer): TAHMTimestamp;
  public
    constructor Create;
    destructor Destroy; override;
    property ActualFPS: Integer read FActualFPS;
    property MaximumFPS: Integer read FMaximumFPS write SetMaximumFPS;
    property AverageFrameTime: Integer read FAverageFrameTime;
    property DateFormat: String read FDateFormat write FDateFormat;
    property TimeFormat: String read FTimeFormat write FTimeFormat;
    property CurrentTime: String read FCurrentTime;
    property CurrentDate: String read FCurrentDate;
    property StartedDate: TDateTime read FStartedDate;
    property StartedTime: TDateTime read FStartedTime;
    property RunningTime: TDateTime read GetRunningTime;
    property CurrentTimeStamp: TAHMTimestamp read FCurrentTimestamp;
    property CurrentFrameTime: Integer read FCurrentFrameTime;
    property ProfilingCount: Integer read GetProfilingCount;
    property ProfilingNames[Index: Integer]: String read GetProfilingName;
    property ProfilingTimes[Index: Integer]: TAHMTimestamp read GetProfilingDelay;
    property Expired: Boolean read FExpired;
    procedure InitialiseTimer;
    function WaitForNextFrame: Boolean;
    procedure PreRequestRender;
    function RequestRender: Boolean;
    procedure CancelRenderRequests;
    procedure BeginFrameTiming;
    procedure UpdateFrameTiming;
    procedure EndFrameTiming;
    procedure BeginProfiling(ProfileName: String);
    procedure EndProfiling(ProfileName: String);
    function HasDurationElapsed(StartTimestamp, Duration: TAHMTimestamp): Boolean;
    function SecondsToString(Seconds: LongInt; ShowHours: Boolean = True): String;
  end;

  TAHMTimerInstance = class
  private
    FTimestamp: TAHMTimestamp;
  protected
  public
    constructor Create;
    property Timestamp: TAHMTimestamp read FTimestamp;
    procedure Reset;
  end;

  TAHMTimerManager = class
  private
    FTimers: TStringList;
  protected
    procedure ClearTimers;
    procedure ClearTimer(Index: Integer);
  public
    constructor Create;
    destructor Destroy; override;
    procedure UpdateTimers;
    procedure StartTimer(Timer: TAHMTimer);
    procedure ResetTimer(Timer: TAHMTimer);
    procedure StopTimer(Timer: TAHMTimer);
  end;

var
  TimerInstance: TAHMTiming;


implementation

uses Windows, MMSystem, MetaConsts, SysUtils, DateUtils, Logging,
     ApplicationManager, Functions, Actions, Utilities;

//----------------------------------------------------------------------------//
// TAHMTiming

constructor TAHMTiming.Create;
begin
  inherited Create;

  // Create global render event signal
  FRenderEvent := TSimpleEvent.Create;
  FRequestEvent := TSimpleEvent.Create;

  // Initialise fullspeed rendering
  FExternalTiming := False;
  FRenderEvent.SetEvent;

  // Create profile list object
  FProfiles := TStringList.Create;

  // Set a new timestamp to process this frame & reset FPS calculation
  FLaunchTimestamp := timeGetTime;
  FCurrentTimestamp := FLaunchTimestamp;
  FFPSTimestamp := FCurrentTimestamp;
  FDisplayPowerTimestamp := FCurrentTimestamp;
  FActualFPS := 0;
  FFrameCount := 0;

  // Log app startup date/time
  FStartedDate := Date;
  FStartedTime := Time;
end;

destructor TAHMTiming.Destroy;
begin
  FRenderEvent.Free;
  FRequestEvent.Free;
  FProfiles.Free;

  inherited Destroy;
end;

function TAHMTiming.SecondsToString(Seconds: LongInt; ShowHours: Boolean): String;
var
  H, M: LongInt;
begin
  // Always show hours if > 59 minutes
  ShowHours := ShowHours or (Seconds > 3599);

  // Convert passed time in seconds to string representation in HH:MM:SS format
  H := Seconds div 3600;
  Seconds := Seconds mod 3600;
  M := Seconds div 60;
  Seconds := Seconds mod 60;
  if ShowHours then Result := Format('%.2d:%.2d:%.2d', [H, M, Seconds])
               else Result := Format('%.2d:%.2d', [M, Seconds]);
end;

procedure TAHMTiming.SetMaximumFPS(MaximumFPS: Integer);
begin
  // Disable FPS throttling if not required
  if MaximumFPS = 0 then
  begin
    FMaximumFPS := 0;
    FFrameThrottle := 0;
    Exit;
  end;

  // Validate for sensible value - minimum 5 FPS, maximum 100 FPS
  if MaximumFPS < FPS_MINIMUM then MaximumFPS := FPS_MINIMUM;
  if MaximumFPS > FPS_MAXIMUM then MaximumFPS := FPS_MAXIMUM;

  // Convert FPS to frame duration
  FMaximumFPS := MaximumFPS;
  FFrameThrottle := FPS_MEASURE_TIME div FMaximumFPS;
end;

procedure TAHMTiming.GetCurrentDateAndTime;
var
  sWork: String;
  iPos: Integer;
  CurrentDate: TDateTime;
begin
  // Get current date
  CurrentDate := Date + 0.1; // Add small time offset to fix obscure day of week bug

  // If our date format includes special 'x' character replace with st/nd/rd/th
  iPos := Pos(META_DAY_SUFFIX, FDateFormat);
  if iPos > 0 then
  begin
    case DayOf(CurrentDate) of
      1,21,31: sWork := 'st';
      2,22: sWork := 'nd';
      3,23: sWork := 'rd';
      else sWork := 'th';
    end;

    // Wrap day suffix with quotes so it's ignored by FormatDateTime function
    sWork := Copy(FDateFormat, 1, Pred(iPos)) + '"' +sWork + '"' +
             Copy(FDateFormat, Succ(iPos), 50);
    FCurrentDate := FormatDateTime(sWork, CurrentDate);
  end
  else
    FCurrentDate := FormatDateTime(FDateFormat, CurrentDate);

  // Time is much easier to handle...
  FCurrentTime := FormatDateTime(FTimeFormat, GetTime);

  // Update date/time metavalues
  with ApplicationManagerInstance.MetaDataManager do
  begin
    SetMetaValue(META_APPTIME, FCurrentTime);
    SetMetaValue(META_APPDATE, FCurrentDate);
  end;
end;

procedure TAHMTiming.InitialiseTimer;
begin
  // Cancel external rendering synchronisation
  CancelRenderRequests;

  // Reset timestamp & FPS calculations
  FLaunchTimestamp := timeGetTime;
  FCurrentTimestamp := FLaunchTimestamp;
  FActualFPS := 0;
  FFrameCount := 0;
end;

function TAHMTiming.WaitForNextFrame: Boolean;
begin
  // Time for next frame - but has our FPS timing interval passed yet?
  if HasDurationElapsed(FFPSTimestamp, FPS_MEASURE_TIME) then
  begin
    // Record the number of frames processed during that interval
    FActualFPS := FFrameCount + 1;
    FAverageFrameTime := Round(FTotalFrameTime / FActualFPS);

    // Update current date & time values
    GetCurrentDateAndTime;

    // Setup our FPS counter for the next interval
    FFrameCount := 0;
    FFPSTimestamp := FCurrentTimestamp;
    FTotalFrameTime := 0;
  end
  else
    // Not passed FPS timing interval yet, so just increment no. of frames
    Inc(FFrameCount);

  // Has our prevent power save interval passed yet?
  if HasDurationElapsed(FDisplayPowerTimestamp, DISPLAY_POWER_INTERVAL * MILLISECS_PER_SEC) then
  begin
{$IFDEF DESIGNER}
    // Don't suppress screensaver if enabled in designer preferences
    with ApplicationManagerInstance.PreferencesManager.DesignerPrefs do
      if not WindowsScreenSaver then
{$ENDIF}
    // Prevent display from entering power save mode - WAKE UP!
    PreventDisplayPowerSave;

    // Reset power save check.
    FDisplayPowerTimestamp := FCurrentTimestamp;
  end;

  // Wait for our render event to be signalled before we leave, or timeout
  case FRenderEvent.WaitFor(VIDEO_TIMEOUT) of
    wrTimeout:
    begin
      // We didn't get called by the video frame, check failed frames
      if FFailedFrames > VIDEO_MAX_FAILS then
      begin
        // Video not responding, so lets resume running at full speed
        FExternalTiming := False;
        FRenderEvent.SetEvent;
      end
      else
      begin
        // Video timed out, but lets run slowly for a while and give it a chance
        Inc(FFailedFrames);
      end;
    end;
    wrSignaled:
    begin
      // Were we signaled externally, or are we running at full speed?
      if FExternalTiming then
      begin
        // We were signaled by video thread, reset for next time and handshake
        FRenderEvent.ResetEvent;
        FRequestEvent.SetEvent;
      end
      else
      begin
        // Using fullspeed timing - but don't max out CPU
        if FFrameThrottle > 0 then Sleep(1)
                              else Sleep(10);
      end;
    end;
  end;

  // Okay, it's now exactly the right time to render...
  Result := True;
end;


procedure TAHMTiming.PreRequestRender;
begin
  // This is signalled from main thread to tell us to back off rendering briefly
  FExternalTiming := True;
  FFailedFrames := 0;
  FRenderEvent.ResetEvent;
end;

function TAHMTiming.RequestRender: Boolean;
begin
  // Set default result - our request was accepted
  Result := True;

  // Video rendering thread has signalled that we need to render a frame now
  FExternalTiming := True;
  FFailedFrames := 0;
  FRenderEvent.SetEvent;

  // Clear our render request
  FRequestEvent.ResetEvent;

  // Give main rendering thread an opportunity to start rendering the frame
  if FRequestEvent.WaitFor(FRAME_TIMEOUT) = wrTimeout then
  begin
    // We weren't ready, so don't render this time
    FRenderEvent.ResetEvent;
    Result := False;
  end;
end;

procedure TAHMTiming.CancelRenderRequests;
begin
  // Resume fullspeed UI rendering (video has stopped)
  FExternalTiming := False;
  FRenderEvent.SetEvent;
end;

function TAHMTiming.GetRunningTime: TDateTime;
begin
  Result := (Date - FStartedDate) + (Time - FStartedTime);
end;

function TAHMTiming.GetProfilingCount: Integer;
begin
  Result := FProfiles.Count;
end;

function TAHMTiming.GetProfilingName(Index: Integer): String;
begin
  Result := FProfiles[Index];
end;

function TAHMTiming.GetProfilingDelay(Index: Integer): TAHMTimestamp;
begin
  Result := TAHMTimestamp(FProfiles.Objects[Index]);
end;

procedure TAHMTiming.BeginFrameTiming;
begin
  // Record timestamp for start of frame
  FFrameTimestamp := timeGetTime;
end;

procedure TAHMTiming.UpdateFrameTiming;
var
  LastFrameTime: TAHMTimestamp;
begin
  // Update timestamp & frame timer for animations & slideshow to use
  // This is not accurate so we won't use this for stats, but is required
  // so we don't break existing code that relies on it
  LastFrameTime := FCurrentTimeStamp;
  FCurrentTimestamp := timeGetTime;
  if FCurrentTimestamp > LastFrametime then
    FCurrentFrametime := FCurrentTimestamp - LastFrameTime;
end;

procedure TAHMTiming.EndFrameTiming;
var
  EndTimestamp: TAHMTimestamp;
  FrameDuration: Integer;
  ThrottleDelay: Integer;
begin
  // Record end of frame stamp & calculate duration
  EndTimestamp := timeGetTime;
  if EndTimestamp > FFrameTimestamp then
    FrameDuration := EndTimestamp - FFrameTimestamp
  else
    FrameDuration := 0;

  // Apply throttling to frame duration if required
  if FrameDuration < FFrameThrottle then
  begin
    ThrottleDelay := FFrameThrottle - FrameDuration;
    FrameDuration := FFrameThrottle;
    Sleep(ThrottleDelay);
  end;

  // Update total time for accurate FPS stats
  FTotalFrameTime := FTotalFrameTime + FrameDuration;
end;

procedure TAHMTiming.BeginProfiling(ProfileName: String);
var
  i: Integer;
begin
  // Start our profiling timestamp
  i := FProfiles.IndexOf(ProfileName);
  if i < 0 then i := FProfiles.Add(ProfileName);
  FProfiles.Objects[i] := TObject(timeGetTime);
end;

procedure TAHMTiming.EndProfiling(ProfileName: String);
var
  i: Integer;
begin
  // Measure elapsed time for our profiled code
  i := FProfiles.IndexOf(ProfileName);
  if i >= 0 then with FProfiles do
    Objects[i] := TObject(timeGetTime - TAHMTimestamp(Objects[i]));
end;

function TAHMTiming.HasDurationElapsed(StartTimestamp, Duration: TAHMTimestamp): Boolean;
begin
  // See whether we have passed our required duration
  Result := (FCurrentTimestamp > (StartTimestamp + Duration)) or (FCurrentTimestamp < StartTimestamp);
end;


//----------------------------------------------------------------------------//
// TAHMTimerInstance

constructor TAHMTimerInstance.Create;
begin
  inherited;

  Reset;
end;

procedure TAHMTimerInstance.Reset;
begin
  // Record current timestamp
  FTimestamp := TimerInstance.CurrentTimestamp;
end;

// TAHMTimerManager

constructor TAHMTimerManager.Create;
begin
  inherited;

  FTimers := TStringList.Create;
end;

destructor TAHMTimerManager.Destroy;
begin
  ClearTimers;
  FTimers.Free;

  inherited;
end;

procedure TAHMTimerManager.ClearTimers;
var
  i: Integer;
begin
  for i := 0 to Pred(FTimers.Count) do
    TAHMTimerInstance(FTimers.Objects[i]).Free;

  FTimers.Clear;
end;

procedure TAHMTimerManager.ClearTimer(Index: Integer);
begin
  TAHMTimerInstance(FTimers.Objects[Index]).Free;
  FTimers.Delete(Index);
end;

procedure TAHMTimerManager.UpdateTimers;
var
  i: Integer;
  Timer: TAHMTimer;
  Instance: TAHMTimerInstance;
begin
  // Loop through all active timers
  for i := Pred(FTimers.Count) downto 0 do
  begin
    // Retrieve timer by name from timer list
    Timer := ApplicationManagerInstance.ThemeManager.InterfaceDescriptor.TimerList.GetTimer(FTimers[i]);

    if Timer = nil then
    begin
      // Remove active timers that have gone out of scope (unloaded descriptor)
      ClearTimer(i);
    end
    else
    begin
      // Check for elapsed timer
      Instance := TAHMTimerInstance(FTimers.Objects[i]);
      if TimerInstance.HasDurationElapsed(Instance.Timestamp, Timer.Interval) then
      begin
        // Signal timer interval actions
        Timer.Actions.InvokeAction(AC_ONTIMER);

        // Remove one shot timers, otherwise reset
        if Timer.RepeatTimer then Instance.Reset
                             else ClearTimer(i);
      end;
    end;
  end;
end;

procedure TAHMTimerManager.StartTimer(Timer: TAHMTimer);
var
  i: Integer;
  Instance: TAHMTimerInstance;
begin
  if not Assigned(Timer) then Exit;

  // Delete this timer if it currently exists
  i := FTimers.IndexOf(Timer.Name);
  if i >= 0 then ClearTimer(i);

  // Create new timer instance
  Instance := TAHMTimerInstance.Create;
  FTimers.AddObject(Timer.Name, Instance);

  // Signal timer start actions
  Timer.Actions.InvokeAction(AC_ONTIMERSTART);
end;
         
procedure TAHMTimerManager.ResetTimer(Timer: TAHMTimer);
var
  i: Integer;
  Instance: TAHMTimerInstance;
begin
  if not Assigned(Timer) then Exit;

  // Timer instance must already exist
  i := FTimers.IndexOf(Timer.Name);
  if i >= 0 then
  begin
    Instance := TAHMTimerInstance(FTimers.Objects[i]);

    // Reset timing period without firing actions
    Instance.Reset;
  end;
end;

procedure TAHMTimerManager.StopTimer(Timer: TAHMTimer);
var
  i: Integer;
begin
  if not Assigned(Timer) then Exit;

  // Timer instance must already exist
  i := FTimers.IndexOf(Timer.Name);
  if i >= 0 then
  begin
    // Remove instance and fire timer stop actions
    ClearTimer(i);
    Timer.Actions.InvokeAction(AC_ONTIMERSTOP);
  end;
end;


initialization
  // Create our timer instance
  TimerInstance := TAHMTiming.Create;

finalization
  // Release timer instance
  TimerInstance.Free;

end.
